home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1999 January - Disc 2 / Macworld (1999-01) (Disk 2).dmg / Serious Demos / Symbolic Composer 4.2 / Environment / Projects / Testers / Solar Tester (With Tunings) < prev    next >
Lisp/Scheme  |  1998-10-26  |  2KB  |  92 lines
  1. ;;; Solar Song Example
  2.  
  3. (def-solar sun
  4.   (dates                    ; rotation speed
  5.     (mercurius 0 59 0 0 0)
  6.     (venus 0 244.3 0 0 0)
  7.     (earth 0 0 23 56 4.1)
  8.     (mars 0 0 24 37 22.6)
  9.     (jupiter 0 0 9 50 0)
  10.     (saturnus 0 0 10 40 0)
  11.     (uranus 0 0 12 0 0)
  12.     (neptunus 0 0 15 48 0)
  13.     (pluto 0 0 6 9 17))
  14.   (cycles                   ; now define year length
  15.     (mercurius 0 87.96 0 0 0)
  16.     (venus 0 224.68 0 0 0)
  17.     (earth 1 0 0 0 0)
  18.     (mars 0 686.95 0 0 0)
  19.     (jupiter 11.862 0 0 0 0)
  20.     (saturnus 29.456 0 0 0 0)
  21.     (uranus 84.07 0 0 0 0)
  22.     (neptunus 164.81 0 0 0 0)
  23.     (pluto 248.53 0 0 0 0))
  24.   (location                 ; and relative location to sun
  25.     (mercurius 1 0 0 0 0)   ; note that you can express any
  26.     (venus 2 0 0 0 0)       ; values here using just a one
  27.     (earth 3 0 0 0 0)       ; parameter and set others as zero
  28.     (mars 4 0 0 0 0)
  29.     (jupiter 5 0 0 0 0)
  30.     (saturnus 6 0 0 0 0)
  31.     (uranus 7 0 0 0 0)
  32.     (neptunus 8 0 0 0 0)
  33.     (pluto 9 0 0 0 0)))
  34.  
  35. (setq waveform 
  36.   (gen-fourier 
  37.    (gen-solar sun cycles jupiter
  38.          mercurius venus earth mars jupiter saturnus uranus neptunus) 
  39.    (reverse 
  40.       (gen-solar sun location jupiter
  41.          mercurius venus earth mars jupiter saturnus uranus neptunus))
  42.    '(0 0 0 0 0 0 0 0 0)
  43.    512))
  44.  
  45. (def-instrument-symbol
  46.    piano (filter-delete '(=) (find-change (vector-to-symbol a e waveform)))
  47. )
  48.  
  49. (def-instrument-velocity
  50.    piano (vector-round 40 127 waveform)
  51. )
  52.  
  53. (create-tonality al-far 
  54.     '(1/1 9/8 27/20 729/512 3/2 9/5 19/10))
  55.  
  56. (create-tonality al-farabi
  57.     '(1/1 16/15 8/7 4/3 3/2 8/5 12/7))
  58.  
  59. (create-tonality byzantine
  60.     '(1/1 18/17 9/7 4/3 3/2 18/11 9/5))
  61.  
  62. (create-tonality dudon-b
  63.     '(1/1 13/12 59/48 4/3 3/2 13/8 59/32))
  64.  
  65. (create-tonality hhosaini
  66.     '(1/1 65536/59049 32/27 4/3 262144/177147 27/16 16/9))
  67.  
  68. (create-tonality ionic
  69.     '(1/1 9/8 5/4 4/3 3/2 5/3 9/5))
  70.  
  71. (create-tonality Joyous6
  72.     '(1/1 9/8 5/4 3/2 5/3 15/8))
  73.  
  74. (create-tonality harm15
  75.     '(1/1 17/16 18/16 19/16 20/16 21/16 22/16 23/16 24/16 25/16 26/16
  76.       27/16 28/16 29/16 30/16 31/16))
  77.  
  78. (def-instrument-tonality
  79.     piano (activate-tonality (harm15 c 4 4020))
  80. )
  81.  
  82. (def-instrument-length
  83.     piano (get-timing '1/16 (find-change (vector-to-symbol a e waveform)))
  84. )
  85.  
  86. (def-instrument-zone
  87.     piano (* 512 (get-tick '1/16))
  88. )
  89.  
  90. (compile-instrument-p "ccl;output:" "Solar Song"
  91.   piano
  92. )